home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / lang / PPCcforth.lha / PPCcforth / forth.dict < prev    next >
Text File  |  1985-12-27  |  18KB  |  1,043 lines
  1. PRIM EXECUTE        0    ( cfa -- <execute word> )
  2. PRIM LIT        1    ( push the next value to the stack )
  3. PRIM BRANCH        2    ( branch by offset in next word )
  4. PRIM 0BRANCH        3    ( branch if zero by off. in next word )
  5. PRIM (LOOP)        4    ( end of a <DO> )
  6. PRIM (+LOOP)        5    ( inc -- <end of a <DO> w/increment != 1 )
  7. PRIM (DO)        6    ( limit init -- <begin a DO loop> )
  8. PRIM I            7    ( get loop index <R> )
  9. PRIM DIGIT        8    ( c -- DIGIT 1 | 0 <convert digit> )
  10. PRIM (FIND)        9    ( s -- s 0 | s NFA 1 <find word s> )
  11. PRIM ENCLOSE        10    ( addr c -- addr next first last <not quite> )
  12. PRIM KEY        11    ( -- c <get next char from input> )
  13. PRIM (EMIT)        12    ( c -- <put char to output> )
  14. PRIM ?TERMINAL        13    ( see if op. interrupted <like w/^C> )
  15. PRIM CMOVE        14    ( src dest count -- <move words>)
  16. PRIM U*            15    ( unsigned multiply )
  17. PRIM U/            16    ( unsigned divide )
  18. PRIM AND        17    ( a b -- a&b )
  19. PRIM OR            18    ( a b -- a|b )
  20. PRIM XOR        19    ( a b -- a%b )
  21. PRIM SP@        20    ( -- sp )
  22. PRIM SP!        21    ( -- <store empty value to sp> )
  23. PRIM RP@        22    ( -- rp )
  24. PRIM RP!        23    ( -- <store empty value to rp> )
  25. PRIM ;S            24    ( -- <pop r stack <end colon def'n>> )
  26. PRIM LEAVE        25    ( -- <set index = limit for a loop> )
  27. PRIM >R            26    ( a -- <push a to r stack> )
  28. PRIM R>            27    ( -- a <pop a from r stack )
  29. PRIM 0=            28    ( a -- !a <logical not> )
  30. PRIM 0<            29    ( a -- a<0 )
  31. PRIM +            30    ( a b -- a+b )
  32. PRIM D+            31    ( ahi alo bhi blo -- a+bhi a+blo )
  33. PRIM MINUS        32    ( a -- -a )
  34. PRIM DMINUS        33    ( ahi alo -- <-a>hi <-a>lo )
  35. PRIM OVER        34    ( a b -- a b a )
  36. PRIM DROP        35    ( a -- )
  37. PRIM SWAP        36    ( a b -- b a )
  38. PRIM DUP        37    ( a -- a a )
  39. PRIM 2DUP        38    ( a b -- a b a b )
  40. PRIM +!            39    ( val addr -- < *addr += val > )
  41. PRIM TOGGLE        40    ( addr mask -- <*addr %= mask> )
  42. PRIM @            41    ( addr -- *addr )
  43. PRIM C@            42    ( addr -- *addr )
  44. PRIM 2@            43    ( addr -- *addr+1 *addr )
  45. PRIM !            44    ( val addr -- <*addr = val> )
  46. PRIM C!            45    ( val addr -- <*addr = val> )
  47. PRIM 2!            46    ( bhi blo addr -- <*addr=blo, *addr+1=bhi )
  48. PRIM DOCOL        47    ( goes into CF of : definitions )
  49. PRIM DOCON        48    ( goes into CF of constants )
  50. PRIM DOVAR        49    ( goes into CF of variables )
  51. PRIM DOUSE        50    ( goes into CF of user variables )
  52. PRIM -            51    ( a b -- a-b )
  53. PRIM =            52    ( a b -- a==b)
  54. PRIM !=            53    ( a b -- a!=b)
  55. PRIM <            54    ( a b -- a<b )
  56. PRIM ROT        55    ( a b c -- c a b )
  57. PRIM DODOES        56    ( place holder; this value goes into CF )
  58. PRIM DOVOC        57
  59. PRIM R            58    ( same as I, but must be a primitive )
  60. PRIM ALLOT        59    ( primitive because of mem. management )
  61. PRIM (BYE)        60    ( executes exit <pop[]>; )
  62. PRIM TRON        61    ( depth -- trace to this depth )
  63. PRIM TROFF        62    ( stop tracing )
  64. PRIM DOTRACE        63    ( trace once )
  65. PRIM (R/W)        64    ( BUFFER FLAG ADDR -- read if flag=1, write/0 )
  66. PRIM (SAVE)        65    ( Save current environment )
  67. PRIM (COLD)        66
  68.  
  69. ( end of primitives )
  70.  
  71. CONST 0 0
  72. CONST 1 1
  73. CONST 2 2
  74. CONST 3 3
  75. CONST -1 -1
  76. CONST BL 32        ( A SPACE, OR BLANK )
  77. CONST C/L 64
  78. CONST B/BUF 1024
  79. CONST B/SCR 1
  80. CONST #BUFF 5        ( IMPLEMENTATION DEPENDENT )
  81.  
  82. CONST WORDSIZE 1    ( EXTENSION: WORDSIZE IS THE NUMBER OF BYTES IN A WORD.
  83.               USUALLY, THIS IS TWO, BUT WITH PSEUDO-MEMORY
  84.               ADDRESSED AS AN ARRAY OF WORDS, IT'S ONE. )
  85.  
  86. CONST FIRST 0        ( ADDRESS OF THE FIRST BUFFER AND END OF BUFFER SPACE )
  87. CONST LIMIT 0        ( the reader fills these in with INITR0 and DPBASE )
  88.  
  89. USER S0        24
  90. USER R0        25
  91. USER TIB    26
  92. USER WIDTH    27
  93. USER WARNING    28
  94. USER FENCE    29
  95. USER DP        30
  96. USER VOC-LINK    31
  97. USER BLK    32
  98. USER IN        33
  99. USER ERRBLK    34
  100. USER ERRIN    35
  101. USER OUT    36
  102. USER SCR    37
  103. USER OFFSET    38
  104. USER CONTEXT    39
  105. USER CURRENT    40
  106. USER STATE    41
  107. USER BASE    42
  108. USER DPL    43
  109. USER FLD    44
  110. USER CSP    45
  111. USER R#        46
  112. USER HLD    47
  113.  
  114. VAR USE 0        ( These two are filled in by COLD )
  115. VAR PREV 0        ( to the same as the constant FIRST )
  116. CONST SEC/BLK 1
  117.  
  118. : EMIT
  119.   (EMIT)
  120.   1 OUT +! ;
  121.  
  122. : CR
  123.   LIT 13 EMIT
  124.   LIT 10 EMIT
  125.   0 OUT ! ;
  126.  
  127. : NOP ;    ( DO-NOTHING )
  128.  
  129. : +ORIGIN ;    ( ADD ORIGIN OF SYSTEM; IN THIS CASE, 0 )
  130.  
  131. : 1+
  132.   1 + ;
  133.  
  134. : 2+
  135.   2 + ;
  136.  
  137. : 1-
  138.   1 - ;
  139.  
  140. : ++        ( ADDR -- <INCREMENTS VAL AT ADDR> )
  141.   1 SWAP +! ;    ( MY OWN EXTENSION )
  142.  
  143. : --        ( ADDR -- <DECREMENTS VAL AT ADDR> )
  144.   -1 SWAP +! ;    ( MY OWN EXTENSION )
  145.  
  146. : HERE        ( -- DP )
  147.   DP @ ;
  148.  
  149. : ,        ( V -- <PLACES V AT DP AND INCREMENTS DP>)
  150.   HERE !
  151.   WORDSIZE ALLOT ;    ( CHANGE FROM MODEL FOR WORDSIZE )
  152.  
  153. : C,        ( C -- <COMPILE A CHARACTER. SAME AS , WHEN WORDSIZE=1> )
  154.   HERE C!
  155.   1 ALLOT ;
  156.  
  157. : U<        ( THIS IS TRICKY. )
  158.     2DUP XOR 0<    ( SIGNS DIFFERENT? )
  159.     0BRANCH U1    ( NO: GO TO U1 )
  160.     DROP 0< 0=    ( YES; ANSWER IS [SECOND > 0] )
  161.     BRANCH U2    ( SKIP TO U2 <END OF WORD> )
  162. LABEL U1
  163.     - 0<    ( SIGNS ARE THE SAME. JUST SUBTRACT
  164.           AND TEST NORMALLY )
  165. LABEL U2
  166.     ;
  167.  
  168. : >        ( CHEAP TRICK )
  169.   SWAP < ;
  170.  
  171. : <>        ( NOT-EQUAL )
  172.   != ;
  173.  
  174. : SPACE        ( EMIT A SPACE )
  175.   BL EMIT
  176. ;
  177.  
  178. : -DUP        ( V -- V | V V <DUPLICATE IF V != 0> )
  179.   DUP
  180.   0BRANCH DDUP1    ( SKIP TO END IF IT WAS ZERO )
  181.   DUP
  182. LABEL DDUP1
  183. ;
  184.  
  185. : TRAVERSE    ( A DIR -- A <TRAVERSE A WORD FROM NFA TO LFA
  186.           <DIR = 1> OR LFA TO NFA <DIR = -1> )
  187.     SWAP
  188. LABEL T1
  189.     OVER    ( BEGIN )
  190.     +
  191.     LIT 0x7F OVER C@ <    ( HIGH BIT CLEAR? )
  192.     0BRANCH T1        ( UNTIL )
  193.     SWAP DROP ;
  194.  
  195. : LATEST        ( NFA OF LAST WORD DEFINED )
  196.   CURRENT @ @ ;
  197.  
  198. : LFA            ( GO FROM PFA TO LFA )
  199.   2 - ;            ( 2 IS WORDSIZE*2 )
  200.  
  201. : CFA            ( GO FROM PFA TO CFA )
  202.   WORDSIZE - ;
  203.  
  204. : NFA            ( GO FROM PFA TO NFA )
  205.   3 -            ( NOW AT LAST CHAR )
  206.   -1 TRAVERSE ;        ( 3 IS WORDSIZE*3 )
  207.  
  208. : PFA            ( GO FROM NFA TO PFA )
  209.   1 TRAVERSE        ( NOW AT LAST CHAR )
  210.   3 + ;            ( 3 IS WORDSIZE*3 )
  211.  
  212. : !CSP            ( SAVE CSP AT USER VAR CSP )
  213.   SP@ CSP ! ;
  214.  
  215. : (ABORT)
  216.   ABORT
  217. ;
  218.  
  219. : ERROR            ( N -- <ISSUE ERROR #N> )
  220.   WARNING @ 0<        ( WARNING < 0 MEANS <ABORT> )
  221.   0BRANCH E1
  222.   (ABORT)        ( IF )
  223. LABEL E1
  224.   HERE COUNT TYPE (.") "?"    ( THEN )
  225.   MESSAGE
  226.   SP!            ( EMPTY THE STACK )
  227.   BLK @ -DUP        ( IF LOADING, STORE IN & BLK )
  228.   0BRANCH E2
  229.   ERRBLK ! IN @ ERRIN !    ( IF )
  230. LABEL E2
  231.   QUIT            ( THEN )
  232. ;
  233.  
  234. : ?ERROR        ( F N -- <IF F, DO ERROR #N> )
  235.   SWAP
  236.   0BRANCH QERR1
  237.   ERROR            ( IF <YOU CAN'T RETURN FROM ERROR> )
  238. LABEL QERR1
  239.   DROP            ( THEN )
  240. ;
  241.  
  242. : ?COMP            ( GIVE ERR#17 IF NOT COMPILING )
  243.   STATE @ 0= LIT 17 ?ERROR
  244. ;
  245.  
  246. : ?EXEC            ( GIVE ERR#18 IF NOT EXECUTING )
  247.   STATE @ LIT 18 ?ERROR
  248. ;
  249.  
  250. : ?PAIRS        ( GIVE ERR#19 IF PAIRS DON'T MATCH )
  251.   - LIT 19 ?ERROR
  252. ;
  253.  
  254. : ?CSP            ( GIVE ERR#20 IF CSP & SP DON'T MATCH )
  255.   SP@ CSP @ - LIT 20 ?ERROR
  256. ;
  257.  
  258. : ?LOADING        ( GIVE ERR#21 IF NOT LOADING )
  259.   BLK @ 0= LIT 22 ?ERROR
  260. ;
  261.  
  262. : COMPILE        ( COMPILE THE CFA OF THE NEXT WORD TO DICT )
  263.   ?COMP
  264.   R> DUP        ( GET OUR RETURN ADDRESS )
  265.   WORDSIZE + >R        ( SKIP NEXT; ORIG. ADDR STILL ON TOS )
  266.   @ ,
  267. ;
  268.  
  269. : [            ( BEGIN EXECUTING )
  270.   0 STATE !
  271. ;*
  272.  
  273. : ]            ( END EXECUTING )
  274.   LIT 0xC0 STATE !
  275. ;*
  276.  
  277. : SMUDGE        ( TOGGLE COMPLETION BIT OF LATEST WORD )
  278.   LATEST        ( WHEN THIS BIT=1, WORD CAN'T BE FOUND )
  279.   LIT 0x20 TOGGLE
  280. ;
  281.  
  282. : :
  283.             ( DEFINE A WORD )
  284.   ?EXEC
  285.   !CSP
  286.   CURRENT @ CONTEXT !
  287.   CREATE ]        ( MAKE THE WORD HEADER AND BEGIN COMPILING )
  288.   (;CODE) DOCOL
  289. ;*
  290.  
  291. : ;            ( END A DEFINITION )
  292.   ?CSP            ( CHECK THAT WE'RE DONE )
  293.   COMPILE ;S        ( PLACE ;S AT THE END )
  294.   SMUDGE [        ( MAKE THE WORD FINDABLE AND BEGIN INTERPRETING )
  295. ;*
  296.  
  297. : CONSTANT
  298.   CREATE SMUDGE ,
  299.   (;CODE) DOCON
  300. ;
  301.  
  302. : VARIABLE
  303.   CONSTANT
  304.   (;CODE) DOVAR
  305. ;
  306.  
  307. : USER
  308.   CONSTANT
  309.   (;CODE) DOUSE
  310. ;
  311.  
  312. : HEX            ( GO TO HEXADECIMAL BASE )
  313.   LIT 0x10 BASE ! ;
  314.  
  315. : DECIMAL        ( GO TO DECIMAL BASE )
  316.   LIT 0x0A BASE !
  317. ;
  318.  
  319. : ;CODE                ( unused without an assembler )
  320.   ?CSP COMPILE (;CODE) [ NOP    ( "ASSEMBLER" might go where nop is )
  321. ;*
  322.  
  323. : (;CODE)            ( differs from the normal def'n )
  324.   R> @ @ LATEST PFA CFA !
  325. ;
  326.  
  327. : <BUILDS        ( UNSURE )
  328.   0 CONSTANT ;        ( NOTE CONSTANT != CONST )
  329.  
  330. : DOES>            ( UNSURE )
  331.   R> LATEST PFA !
  332.   (;CODE) DODOES
  333. ;
  334.  
  335. : COUNT            ( ADDR -- ADDR+1 COUNT )
  336.   DUP 1+ SWAP C@ ;    ( CONVERTS THE <STRING> ADDR TO A FORM SUITABLE
  337.               FOR "TYPE" )
  338.  
  339. : TYPE
  340.   -DUP
  341.   0BRANCH TYPE1
  342.   OVER + SWAP        ( GET START .. END ADDRS )
  343.   (DO)
  344. LABEL TYPE2
  345.     I C@ EMIT
  346.   (LOOP) TYPE2
  347.   BRANCH TYPE3
  348. LABEL TYPE1
  349.   DROP
  350. LABEL TYPE3
  351. ;
  352.  
  353. : -TRAILING        ( addr count -- addr count <count adjusted to
  354.               exclude trailing blanks> )
  355.   DUP 0 (DO)        ( DO )
  356. LABEL TRAIL1
  357.     OVER OVER + 1 - C@ BL -
  358.     0BRANCH TRAIL2
  359.     LEAVE BRANCH TRAIL3    ( IF )
  360. LABEL TRAIL2
  361.     1 -            ( ELSE )
  362. LABEL TRAIL3
  363.   (LOOP) TRAIL1        ( THEN LOOP )
  364. ;
  365.  
  366. : (.")            ( PRINT A COMPILED STRING )
  367.   R COUNT
  368.   DUP 1+ R> + >R TYPE
  369. ;
  370.  
  371. : ."            ( COMPILE A STRING IF COMPILING,
  372.               OR PRINT A STRING IF INTERPRETING )
  373.   LIT '"'
  374.   STATE @
  375.   0BRANCH QUOTE1
  376.   COMPILE (.") WORD HE